home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / Rexx / Cartouche.amiCAD < prev    next >
Text File  |  1998-08-08  |  4KB  |  159 lines
  1. /* Script ARexx permettant le tracé d'un cartouche dans une fenêtre AmiCAD */
  2. /* Chez Corbin, Vendredi 3 Octobre 1997, Version 1.00, © R.Florac */
  3. /* Version 1.01, 2 Novembre 1997, trait vertical rajouté dans cartouche */
  4. /* Version 1.02, 23 janvier 1998, ajout titre, date, etc... */
  5. /* Version 1.03, 12 février 1998, test longueurs chaînes pour ajustement largeur */
  6. /* Version 1.04, 24 mai 1998, test présence rexxlocaldates.library */
  7. /* Version 1.05, 21 juin 1998, ajout test après choix emplacement cartouche pour arrêt */
  8. /* Version 1.06, 14 juillet 1998, modification tracé lignes (lignes quelconques) */
  9. /* $VER: Cartouche.AmiCAD 1.06 (© R.Florac, 14/07/98) */
  10.  
  11. options results
  12.  
  13. organisation="LYCÉE Bernard PALISSY SAINTES"
  14. signal on error
  15. signal on syntax
  16.  
  17. if (~show('L','rexxlocaldates.library')) then
  18.   call addlib('rexxlocaldates.library',0,-30,0)
  19.  
  20. if (show('L','rexxlocaldates.library')) then do
  21.     Ib = OpenLocale()
  22.     jour = FormatDate(Ib, ,"%A %e %B %Y")
  23. end
  24. else do
  25.     'DATE(1)'; jour=result
  26. end
  27.  
  28. 'WWIDTH(-1)'; l = result; lc = result % 3
  29. 'WHEIGHT(-1)'; h =result
  30. 'ROTATE(0,0):SYMMETRY(0,0)'
  31.  
  32. 'SELECT("Emplacement du cartouche"+CHR(10)+"En haut à gauche"+CHR(10)+"En haut à droite"+CHR(10)+"En haut au centre"+CHR(10)+"En bas au centre"+CHR(10)+"En bas à droite"+CHR(10)+"En bas à gauche")'
  33. c = result
  34. if c<1 then exit    /* Version 1.05 */
  35.  
  36. 'ASK("Titre du cartouche")'; titre = result
  37. if titre='' then exit
  38.  
  39. if lc<260 then lc=260
  40. 'TXWIDTH("'organisation'")'; lt = result
  41. if lt>lc-10 then lc=lt+10
  42. 'TXWIDTH("'titre'")'; lt = result
  43. if lt>lc-10 then lc=lt+10
  44. dx=(lc+5)%4*3
  45. 'TXWIDTH("'jour'")'; lt = result
  46. if lt>dx-10 then do
  47.     dx=lt+10
  48.     lc=dx%3*4
  49. end
  50.  
  51. select
  52.     when c = 1 then do        /* En haut à gauche */
  53.     x0 = 5
  54.     x1 = lc + 5
  55.     y0 = 5
  56.     y1 = 85
  57.     bh = 0
  58.     bb = 1
  59.     bg = 0
  60.     bd = 1
  61.     end
  62.     when c = 2 then do        /* En haut à droite */
  63.     x0 = l - lc - 5
  64.     x1 = l - 5
  65.     y0 = 5
  66.     y1 = 85
  67.     bh = 0
  68.     bb = 1
  69.     bg = 1
  70.     bd = 0
  71.     end
  72.     when c = 3 then do        /* En haut au centre */
  73.     x0 = l % 2 - lc % 2
  74.     x1 = x0 + lc
  75.     y0 = 5
  76.     y1 = 85
  77.     bh = 0
  78.     bb = 1
  79.     bg = 1
  80.     bd = 1
  81.     end
  82.     when c = 4 then do        /* En bas au centre */
  83.     x0 = l % 2 - lc % 2
  84.     x1 = x0 + lc
  85.     y0 = h - 85
  86.     y1 = h - 5
  87.     bh = 1
  88.     bb = 0
  89.     bg = 1
  90.     bd = 1
  91.     end
  92.     when c = 6 then do        /* En bas à gauche */
  93.     x0 = 5
  94.     x1 = 5 + lc
  95.     y0 = h - 85
  96.     y1 = h - 5
  97.     bh = 1
  98.     bb = 0
  99.     bg = 0
  100.     bd = 1
  101.     end
  102.     when c = 5 then do        /* En bas à droite */
  103.     x0 = l - lc - 5
  104.     x1 = l - 5
  105.     y0 = h - 85
  106.     y1 = h - 5
  107.     bh = 1
  108.     bb = 0
  109.     bg = 1
  110.     bd = 0
  111.     end
  112.     otherwise exit
  113. end
  114.  
  115. /* sauvegarde du contexte, dessin du contour */
  116. 'SAVEALL(-1):DRAWMODE(-2):DRAW(5,5,'l-5',5):DRAW('l-5',5,'l-5','h-5')'
  117. 'DRAW('l-5','h-5',5,'h-5'):DRAW(5,'h-5',5,5)'
  118.  
  119. /* Tracé du bord horizontal haut */
  120. if bh > 0 then 'DRAW('x0','y0','x1','y0')'
  121. /* Tracé du bord horizontal bas */
  122. if bb > 0 then 'DRAW('x0','y1','x1','y1')'
  123. /* Tracé du bord vertical gauche */
  124. if bg > 0 then 'DRAW('x0','y0','x0','y1')'
  125. /* Tracé du bord vertical droit */
  126. if bd > 0 then 'DRAW('x1','y0','x1','y1')'
  127. /* Tracé des lignes horizontales intermédiaires */
  128. 'DRAW('x0','y0+20','x1','y0+20')'
  129. 'DRAWMODE(-1):DRAW('x0','y0+40','x1','y0+40'):DRAW('x0','y0+60','x1','y0+60')'
  130. /* Tracé de la ligne verticale intermédiaire */
  131. 'DRAW('dx+x0','y0+40','dx+x0','y1')'
  132.  
  133. 'SETSCALE(0,1,1)'
  134. call centrer_texte(organisation,x0,x1,y0+15)
  135. call centrer_texte(titre,x0,x1,y0+35)
  136. call centrer_texte(jour,x0,x0+dx,y0+75)
  137. call centrer_texte("Document Numéro 1/1",x0,x0+dx,y0+55)
  138. call centrer_texte("REV 1",x0+dx,x1,y0+55)
  139. call centrer_texte("AmiCAD",x0+dx,x1,y0+75)
  140.  
  141. exit
  142.  
  143. centrer_texte: procedure
  144.     parse arg texte, xg, xd, y
  145.     'TXWIDTH("'texte'")'; l = result
  146.     l = (xd-xg-l)%2
  147.     'WRITE("'texte'",'xg+l','y')'
  148.     return
  149.  
  150. /* Traitement des erreurs, interruption du programme */
  151. syntax:
  152. erreur=RC
  153. 'MESSAGE("Script Cartouche.AmiCAD:"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  154. exit
  155.  
  156. error:
  157. 'MESSAGE("Script Cartouche.AmiCAD:"+CHR(10)+"Erreur en ligne 'SIGL'")'
  158. exit
  159.